perm filename TABLA.OLD[OLD,LCS] blob
sn#213106 filedate 1976-08-07 generic text, type T, neo UTF8
00100 C CONVERTS LUTE TABLATURE TO STANDARD INPUT FOR MS.
00200
00300 DIMENSION I(72),IQ(72),LET(14),NUM(8),LIST(14),KLST(8)
00400 1,RI(72),STR(50),FOR(3)
00500 C NO MORE THAN 50 NOTES PER FILE.
00600 C NOTE: USE 'C' FOR r AND 'Q' FOR k. (R=REST, K=KEY SIG.)
00700 C ON THE OTHER HAND! USE 'Z' FOR MEASURE LINES ('M' IS TABLATURE ITEM)
00800 DATA LET/'A','B','C','D','E','F','G','H','I','J','Q',
00900 1 'L','M','N'/,NUM/'1','2','3','4','5','6','7','8'/
01000 1,LSL/'/'/,IBLA/' '/,ICOL/':'/,ISEMI/';'/,MIN/'-'/
01100 1,IR/'R'/,IX/'X'/,IZ/'Z'/,M100/100/
01200 1,LIST/'A','B','B','C','C','D','E','E','F','F',
01300 1 'G','G','A','B'/,IS/'S'/,IK/'K'/
01400 1,KLST/'B','E','A','D', 'F','C','G','D'/
01500 1,FOR/0,',F4.2',',A1)'/ ,F3/'(F2.0'/,F4/'(F3.0'/
01600 EQUIVALENCE (ID,LET(4)),(IF,LET(6)),(IM,LET(13)),(IN,LET(14))
01700 1,(RI,I)
01800
01900 TYPE 1
02000 1 FORMAT(' TYPE FILE NAME -- '$)
02100 2 FORMAT(A5)
02200 ACCEPT 2,NAME
02300 TYPE 3
02400 ACCEPT 2,NM2
02500 3 FORMAT(' TYPE OUTPUT NAME -- '$)
02600 20 FORMAT(I,72A1)
02700 22 FORMAT(72A1)
02800 222 FORMAT(1X72A1)
02900 2222 FORMAT(F5.0,F4.2,A1)
03000 IF(NM2.EQ.IBLA)NM2='TABL'
03100 CALL IFILE(1,NAME)
03200 CALL OFILE(21,NM2)
03300 ISGN=0
03400 JND=0
03500
03600 240 MODE=-1
03700 READ(1,20,END=102)L,I
03800 TYPE 20,L,I
03900 C READS SOS LINE NUMBERS
04000
04100 IMIN=0
04200 ITOT=0
04300 ICHRD=0
04400 NN=1
04500
04600 NTS=-1
04700 21 N=1
04800 8 J=0
04900 NX=0
05000 NL=-1
05100 31 JM=M
05200 M=I(N)
05300 IF(M.EQ.LSL)GO TO 10
05400 IF(M.EQ.ICOL)GO TO 10
05500 IF(M.EQ.ISEMI)GO TO 13
05600 IF(M.NE.IBLA)GO TO 36
05700 IF(JM.EQ.M)GO TO 35
05800 C NEVER MORE THAN ONE BLANK AT A TIME.
05900 GO TO 7
06000
06100 36 DO 32 K=1,14
06200 32 IF(M.EQ.LET(K))GO TO 11
06300 IF(M.NE.IS.AND.M.NE.IR)GO TO 76
06400 C FINDS 'S' OR 'R'
06500 LETX=0
06600 NX=NX+1
06700 IQ(NX)=M
06800 N=N+1
06900 M=I(N)
07000 GO TO 7
07100 C FOR 'SD' AND 'SU', 'RD', 'RI'
07200
07300 76 IF(M.EQ.'0')GO TO 74
07400 C BASS STRINGS ARE 0, -1, -2, ETC. -- ALSO USE /SD/
07500 IF(M.NE.MIN)GO TO 33
07600
07700 9 IMIN=-1
07800 LETX=-1
07900 J=0
08000 C SO OCT. NUM WILL APPEAR FOR HIGH NOTES AFTER BASS STRINGS
08100 N=N+1
08200 M=I(N)
08300 33 DO 34 K=1,8
08400 34 IF(M.EQ.NUM(K))GO TO 12
08500 LETX=0
08600 IF(M.NE.IK)GO TO 37
08700 ISGN=1
08800 C FOUND A KSIG
08900 39 NX=NX+1
09000 IQ(NX)=M
09100 N=N+1
09200 M=I(N)
09300 IF(M.NE.MIN)GO TO 33
09400 C FOUND MINUS
09500 ISGN=-1
09600 GO TO 39
09700
09800 74 L=7
09900 J=0
10000 LETX=-1
10100 77 NX=NX+1
10200 C FOR OCTAVE NUM
10300 IQ(NX)=LET(L)
10400 NX=NX+1
10500 M=3
10600 IF(L.LT.3)M=2
10700 IQ(NX)=NUM(M)
10800 GO TO 35
10900 75 L=7-K
11000 IMIN=0
11100 GO TO 77
11200
11300 37 IF(M.EQ.IZ)M=IM
11400 C CHANGE Z (MEASURE) TO M
11500 GO TO 7
11600
11700 35 N=N+1
11800 IF(N.LT.72)GO TO 31
11900 IF(NX.GT.72)GO TO 101
12000 WRITE(21,22)(IQ(K),K=1,NX)
12100 TYPE 222,(IQ(K),K=1,NX)
12200 14 IF(MODE)GO TO 140
12300 MODE=MODE+1
12400 IF(MODE.EQ.3)GO TO 240
12500 C FOR RESTART. DON'T PUT BASS STRS FIRST. ONLY 1 LN FOR BMS &SLRS
12600 140 READ(1,20,END=100)L,I
12700 TYPE 20,L,I
12800 IF(NTS)GO TO 21
12900 C NEXT FOR LINES AFTER NOTES.
13000 C NEXT FOR STRING NUMS.
13100 IF(I(1).NE.IBLA)GO TO 70
13200 C TO SKIP ALL RHYTH LINES
13300 IF(MODE.GE.0)GO TO 70
13400 C SO WE WON'T EVER COME BACK HERE
13500 73 L=0
13600 NL=LSL
13700 CC ITOT=ITOT-1
13800 FOR(1)=F3
13900 NA=0
14000 DO 71 K=1,ITOT
14100 C ITOT = TOTAL NUM OF NOTES
14200 A=STR(K)
14300 IF(A)GO TO 71
14400 JJ=K
14500 171 JJ=JJ+1
14600 IF(STR(JJ).GT.0)GO TO 272
14700 IF(JJ.EQ.ITOT)NL=ISEMI
14800 GO TO 171
14900 272 NA=NA+1
15000 L=L+2
15100 RI(L-1)=NA
15200 RI(L)=A*.01
15300 IF(K.EQ.ITOT)NL=ISEMI
15400 IF(NA.GT.9)FOR(1)=F4
15500 CC71 WRITE(21,72)RI(L-1),RI(L),M
15600 TYPE 2222,RI(L-1),RI(L),NL
15700 WRITE(21,FOR)RI(L-1),RI(L),NL
15800 71 CONTINUE
15900 MODE=0
16000 C NOW SET MODE COUNTER TO PREPARE FOR RESTART
16100 GO TO 14
16200 70 WRITE(21,22)(I(K),K=1,72)
16300 GO TO 14
16400 100 IF(NL.NE.ISEMI)GO TO 73
16500 102 STOP
16600 101 FORMAT(' TOO MUCH ON LINE')
16700 TYPE 101
16800 STOP
16900
17000 11 NL=K
17100 C THE NUMB. OF THE LETTER
17200 LETX=-1
17300 GO TO 35
17400 12 IF(ISGN.EQ.0)GO TO 47
17500 C NEXT FOR KSIG SETUP
17600 JFST=5
17700 IF(ISGN)JFST=1
17800 JND=JFST+K-1
17900 ISGN=0
18000 47 IF(IMIN)GO TO 75
18100 C JUMP FOR BASS STRINGS
18200 IF(NL)GO TO 7
18300 NN=K
18400 C THE NUMBER
18500 GO TO 35
18600
18700 C NEXT AFTER IT FOUND SLASH OR SEMICOLON
18800 13 NTS=0
18900 10 IF(LETX.EQ.0)GO TO 110
19000 ITOT=ITOT+1
19100 C SAVE THE STRING NUM.
19200 NA=NN
19300 IF(ICHRD.EQ.ICOL)NA=-1
19400 C FLAG FOR CHORD NOTES (CAN'T SPECIFY STRING IN BEAMS SUBR.)
19500 STR(ITOT)=NA
19600 ICHRD=M
19700 110 IF(NL)GO TO 7
19800 JOCT=0
19900 GO TO(41,42,43,44,45,46),NN
20000 46 NA=0
20100 GO TO 5
20200 45 NA=5
20300 C THESE ARE ADDERS FOR 'LIST'
20400 GO TO 5
20500 44 NA=8
20600 GO TO 5
20700 43 NA=0
20800 GO TO 6
20900 C NOW ON THE UPPER 3 STRINGS
21000 42 NA=5
21100 GO TO 6
21200 41 NA=8
21300 6 JOCT=1
21400 C THE OCTAVE ADDER
21500 5 NX=NX+1
21600 NB=NL+NA
21700 C PUT A NOTE AWAY
21800 18 L=LIST(NB)
21900 IQ(NX)=L
22000 C THE FOUND-NOTE FLAG
22100 C SAVE THE STRING NUM.
22200 58 GO TO(51, 52,51,51, 55,51, 52,51,51, 55,51, 55,51, 52),NB
22300 C FINDS FLAT OR SHARP -- WHAT ABOUT KSIG.
22400 52 K=IF
22500 GO TO 50
22600 55 K=IS
22700 50 IF(JND.EQ.0)GO TO 53
22800 DO 54 KA=JFST,JND
22900 54 IF(L.EQ.KLST(KA))GO TO 56
23000 C LOOK FOR KSIG MATCH UP
23100 GO TO 53
23200 56 IF(K.NE.0)GO TO 57
23300 K=IN
23400 C MAKES A NATURAL
23500 53 NX=NX+1
23600 IQ(NX)=K
23700 57 NA=3
23800 NL=-1
23900 IF(NB.GT.3)NA=4
24000 NA=NA+JOCT
24100 IF(J.EQ.NA)GO TO 7
24200 C AVOIDS REPEATING OCT. NUM
24300 J=NA
24400 NX=NX+1
24500 IQ(NX)=NUM(NA)
24600 7 NX=NX+1
24700 IQ(NX)=M
24800 IF(M.EQ.ISEMI)NTS=0
24900 GO TO 35
25000 51 K=0
25100 GO TO 50